home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / cocktail / puma.lha / puma / src / opt.puma < prev    next >
Text File  |  1992-09-25  |  14KB  |  462 lines
  1. /* Ich, Doktor Josef Grosch, Informatiker, 10.12.1991 */
  2.  
  3. TRAFO Optimize PUBLIC Optimize RuleProperties NeedsTempo NeedsMatch NeedsNoFinale GetRule
  4.  
  5. GLOBAL {
  6.  
  7. FROM IO        IMPORT StdOutput, WriteB, WriteS, WriteI, WriteNl;
  8. FROM Idents    IMPORT WriteIdent;
  9. FROM Mod    IMPORT ImplMod;
  10. FROM Tree    IMPORT tTree, NoTree, mTestIsType, mNodeTypes;
  11. FROM Scanner    IMPORT Warning;
  12. FROM Positions    IMPORT tPosition;
  13.  
  14. FROM Sets    IMPORT
  15.    tSet        , MakeSet    , ReleaseSet    , AssignEmpty    ,
  16.    IsEmpty    , Difference    , IsSubset    , Assign    ,
  17.    IsEqual    , IsNotEqual    , Intersection    , Union        ,
  18.    Size        , WriteSet    ;
  19.  
  20. IMPORT Sets;
  21.  
  22. VAR
  23.    gHasExit, gHasAssign, gHasTargetCode, gHasRejectOrFail: BOOLEAN;
  24.    gRule, nNoDecision, nNoTest    : tTree;
  25.  
  26. PROCEDURE IsDisjoint (s1, s2: tSet): BOOLEAN;
  27.    VAR s: tSet; Result: BOOLEAN;
  28.    BEGIN
  29.       MakeSet (s, Size (s1));
  30.       Assign (s, s1);
  31.       Intersection (s, s2);
  32.       Result := IsEmpty (s);
  33.       ReleaseSet (s);
  34.       RETURN Result;
  35.    END IsDisjoint;
  36. }
  37.  
  38. PROCEDURE Optimize (t: Tree)
  39.  
  40. Spec (..) :-
  41.    nNoDecision    := NoDecision ();
  42.    nNoTest    := NoTest ();
  43.    Optimize (Routines);
  44.    .
  45. Routine (..) :-
  46.    RuleProperties (Rules);
  47.    CollectTests (Rules, InForm);
  48.    BuildTree (Rules, nNoDecision => decisions);
  49.    Decisions := decisions;
  50.    ElimDeadTests (Decisions, _, (FALSE), _);
  51.    FindCases (Decisions => _, n, s2);
  52.    MarkCases (Decisions, n, s2);
  53.    Optimize (Next);
  54.    .
  55.  
  56. PROCEDURE RuleProperties (Tree)
  57.  
  58. Spec (..) :-
  59.    RuleProperties (Routines);
  60.    .
  61. Routine (..) :-
  62.    RuleProperties (Rules);
  63.    RuleProperties (Next);
  64.    .
  65. Rule (..) :-
  66.    gHasExit      := FALSE;
  67.    gHasAssign      := FALSE;
  68.    gHasTargetCode := FALSE;
  69.    gHasRejectOrFail := FALSE;
  70.    RuleProperties (Statements);
  71.    RuleProperties (Exprs);
  72.    RuleProperties (Expr);
  73.    HasExit      := gHasExit;
  74.    HasAssign      := gHasAssign;
  75.    HasTargetCode  := gHasTargetCode;
  76.    HasRejectOrFail := gHasRejectOrFail;
  77.    RuleProperties (Next);
  78.    .
  79. ProcCall (..) :-
  80.    RuleProperties (Call);
  81.    RuleProperties (Next);
  82.    .
  83. Assignment (..) :-
  84.    gHasAssign      := TRUE;
  85.    RuleProperties (Adr);
  86.    RuleProperties (Expr);
  87.    RuleProperties (Next);
  88.    .
  89. Condition (..) :-
  90.    gHasExit      := TRUE;
  91.    RuleProperties (Next);
  92.    .
  93. Reject (..) :-
  94.    gHasExit      := TRUE;
  95.    gHasRejectOrFail := TRUE;
  96.    RuleProperties (Next);
  97.    .
  98. Fail (..) :-
  99.    gHasRejectOrFail := TRUE;
  100.    RuleProperties (Next);
  101.    .
  102. TargetStmt (..) :-
  103.    gHasTargetCode := TRUE;
  104.    RuleProperties (Next);
  105.    .
  106. Statement (..) :-
  107.    RuleProperties (Next);
  108.    .
  109. OneExpr (..) :-
  110.    RuleProperties (Expr);
  111.    RuleProperties (Next);
  112.    .
  113. Expr:Expr (..) :-
  114.    gHasExit := gHasExit OR NeedsMatch (Expr);
  115.    .
  116.  
  117. PREDICATE NeedsMatch ([Tests, Exprs, Expr])
  118.  
  119. TestValue (..) :- NeedsMatch (Expr) OR NeedsMatch (Next);
  120.    .
  121. OneTest    (..) :- NeedsMatch (Next);
  122.    .
  123. OneExpr    (..) :- NeedsMatch (Expr) OR NeedsMatch (Next);
  124.    .
  125. Compose (..) :- NeedsMatch (Exprs);
  126.    .
  127. Call    (..) :- NeedsMatch (Expr) OR NeedsMatch (Exprs) OR
  128.         (Object # NoTree) AND NeedsMatch2 (Patterns, Object^.Routine.OutForm);
  129.    .
  130. Binary    (..) :- NeedsMatch (Lop) OR NeedsMatch (Rop);
  131.    .
  132. Parents    (..) ;
  133. PreOperator    (..) ;
  134. PostOperator    (..) :- NeedsMatch (Expr);
  135.    .
  136. Index    (..) :- NeedsMatch (Expr) OR NeedsMatch (Exprs);
  137.    .
  138.  
  139. PREDICATE NeedsMatch2 ([Patterns, Pattern], Formal)
  140.  
  141. OnePattern (..), Formals :-
  142.    NeedsMatch2 (Pattern, Formals) OR
  143.    NeedsMatch2 (Next, Formals^.Formal.Next);
  144.    .
  145. Decompose (..), Formal (_, _, typeDesc, _) :-
  146.    (typeDesc^.Kind = Tree.UserType) OR
  147.    IsNotEqual (Object^.Class.TypeDesc^.NodeTypes.Types, typeDesc^.NodeTypes.Types) OR
  148.    NeedsMatch2 (Patterns, Object^.Class.Formals);
  149.    .
  150. VarDef    (..), _ :- Object # NoTree; .
  151. NilTest    (..), _ :- .
  152. Value    (..), _ :- .
  153.  
  154. PREDICATE NeedsTempo (Decisions => Rule)
  155.  
  156. Decision (Then, ..) => Rule :- NeedsTempo (Then => Rule); .
  157. Decided (_, rule:Rule (HasTempos := (TRUE))) => rule :- .
  158.  
  159. PREDICATE NeedsNoFinale (Decisions)
  160.  
  161. Decision (_, Else, ..) :- NeedsNoFinale (Else); .
  162. Decided (_, Rule (HasExit := (FALSE))) :- .
  163. Decided (Else, _) :- NeedsNoFinale (Else); .
  164.  
  165. PROCEDURE GetRule (Decisions => Rule)
  166.  
  167. Decision (Then, ..) => Rule :- GetRule (Then => Rule); .
  168. Decided (_, Rule) => Rule :- .
  169.  
  170. PROCEDURE CollectTests (Rules, Formals)
  171.  
  172. Rule (..), Formals :-
  173.    CollectTests2 (Patterns, Formals, nNoTest => tests);
  174.    Tests := tests;
  175.    CollectTests (Next, Formals);
  176.    .
  177.  
  178. PROCEDURE CollectTests2 (Tree, Formals, Tests => Tests)
  179.  
  180. OnePattern (Pattern, NextP), Formals:Formal (NextF, ..),
  181.    TestsIn => TestsOut :-
  182.    CollectTests2 (NextP, NextF, TestsIn => Tests);
  183.    CollectTests2 (Pattern, Formals, Tests => TestsOut);
  184.    .
  185. Decompose (..), Formal (_, _, typeDesc, _),
  186.    TestsIn => TestsOut :-
  187.    (typeDesc^.Kind # Tree.UserType) AND
  188.       IsEqual (Object^.Class.TypeDesc^.NodeTypes.Types, typeDesc^.NodeTypes.Types);
  189.    CollectTests2 (Patterns, Object^.Class.Formals, TestsIn => TestsOut);
  190.    .
  191. Decompose (_, _, _, Path, _, _, Patterns, _, Object), Formal (_, _, typeDesc, _),
  192.    TestsIn => TestKind (TestsOut, Path, Object^.Class.TypeDesc, Object^.Class.Name) :-
  193.    Object^.Class.Extensions^.Kind = Tree.NoClass;    /* Low ? */
  194.    CollectTests2 (Patterns, Object^.Class.Formals, TestsIn => TestsOut);
  195.    .
  196. Decompose (_, _, _, Path, _, _, Patterns, _, Object), _,
  197.    TestsIn => TestIsType (TestsOut, Path, Object^.Class.TypeDesc, Object^.Class.Name) :-
  198.    CollectTests2 (Patterns, Object^.Class.Formals, TestsIn => TestsOut);
  199.    .
  200. VarDef (Path := path), _,
  201.    Tests => TestNonlin (Tests, Object^.Formal.Path, path, Object^.Formal.TypeDesc) :-
  202.    Object # NoTree;
  203.    .
  204. NilTest (_, _, _, Path, _), _,
  205.    Tests => TestNil (Tests, Path) :-
  206.    .
  207. Value (_, _, _, Path, Expr), Formals:Formal,
  208.    Tests => TestValue (Tests, Path, Expr, Formals^.Formal.TypeDesc) :-
  209.    .
  210. _, _, Tests => Tests :-
  211.    .
  212.  
  213. PREDICATE IsSamePath (Path, Path)
  214.  
  215. Var (Name, ..)        , Var (Name, ..)    :- .
  216. ConsType (Path1, Name)    , ConsType (Path2, Name);
  217. Field (Path1, Name)    , Field (Path2, Name)    :- IsSamePath (Path1, Path2); .
  218.  
  219. PREDICATE IsSameType (TypeDesc, TypeDesc)
  220.  
  221. NodeTypes (TreeName (Name, ..), Types), NodeTypes (TreeName (Name, ..), Types) :- .
  222. UserType (Type), UserType (Type) :- .
  223.  
  224. PREDICATE IsSameTest (Tests, Tests)
  225.  
  226. TestKind   (_, Path1, TypeDesc1, _), TestKind   (_, Path2, TypeDesc2, _) ;
  227. TestIsType (_, Path1, TypeDesc1, _), TestIsType (_, Path2, TypeDesc2, _) :-
  228.    IsSamePath (Path1, Path2);
  229.    IsSameType (TypeDesc1, TypeDesc2);
  230.    .
  231. TestNil (_, Path1), TestNil (_, Path2) :-
  232.    IsSamePath (Path1, Path2);
  233.    .
  234. TestNonlin (_, Path11, Path12, _), TestNonlin (_, Path21, Path22, _) :-
  235.    IsSamePath (Path11, Path21);
  236.    IsSamePath (Path12, Path22);
  237.    .
  238.  
  239. PROCEDURE BuildTree (Rules, Decisions => Decisions)
  240.  
  241. r:Rule (..), DecisionsIn => DecisionsOut :-
  242.    gRule := r;
  243.    BuildTree2 (Tests, DecisionsIn => Decisions);
  244.    UpdateChange (Decisions, gRule);
  245.    BuildTree (Next, Decisions => DecisionsOut);
  246.    .
  247. NoRule (..), Decisions => Decisions :-
  248.    .
  249.  
  250. PROCEDURE BuildTree2 (t: Tests, d: Decisions => Decisions)
  251.  
  252. o:OneTest (Next, _), NoDecision () => Decision (Decisions, d, o, 0, TRUE) :-
  253.    BuildTree2 (Next, d => Decisions);
  254.    UpdateChange (Decisions, gRule);
  255.    .
  256. OneTest (Next, _), Decision (Then, Else, Test, _, (TRUE)) => d /* Decision (Decisions, Else, Test, 0, TRUE) */ :-
  257.    IsSameTest (t, Test);
  258.    NOT HasInterference (t, Else);
  259.    BuildTree2 (Next, Then => Decisions);
  260.    Then := Decisions;
  261.    UpdateChange (Decisions, gRule);
  262.    .
  263. OneTest (..), Decision (Then, Else, Test, _, _) => d /* Decision (Then, Decisions, Test, 0, TRUE) */ :-
  264.    BuildTree2 (t, Else => Decisions);
  265.    Else := Decisions;
  266.    UpdateChange (Decisions, gRule);
  267.    .
  268. OneTest (..), Decided (Else, Rule) => d /* Decided (Decisions, Rule) */ :-
  269.    BuildTree2 (t, Else => Decisions);
  270.    Else := Decisions;
  271.    UpdateChange (Decisions, gRule);
  272.    .
  273. NoTest (), NoDecision () => Decided (d, gRule) :-
  274.    .
  275. NoTest (), Decision (Then, Else, Test, _, _) => d /* Decision (Then, Decisions, Test, 0, TRUE) */ :-
  276.    BuildTree2 (t, Else => Decisions);
  277.    Else := Decisions;
  278.    .
  279. NoTest (), Decided (Else, Rule) => d /* Decided (Decisions, Rule) */ :-
  280.    BuildTree2 (t, Else => Decisions);
  281.    Else := Decisions;
  282.    .
  283.  
  284. PREDICATE HasInterference (Tests, Decisions)
  285.  
  286. _, Decided (..) :- .
  287.            TestKind   (_, Path1, NodeTypes (_, Types1), _),
  288.    Decision (_, _, TestKind   (_, Path2, NodeTypes (_, Types2), _), ..) ;
  289.            TestKind   (_, Path1, NodeTypes (_, Types1), _),
  290.    Decision (_, _, TestIsType (_, Path2, NodeTypes (_, Types2), _), ..) ;
  291.            TestIsType (_, Path1, NodeTypes (_, Types1), _),
  292.    Decision (_, _, TestKind   (_, Path2, NodeTypes (_, Types2), _), ..) ;
  293.            TestIsType (_, Path1, NodeTypes (_, Types1), _),
  294.    Decision (_, _, TestIsType (_, Path2, NodeTypes (_, Types2), _), ..) :-
  295.    IsSamePath (Path1, Path2);
  296.    NOT IsDisjoint (Types1, Types2);
  297.    .
  298. t, Decision (_, Else, ..) :- HasInterference (t, Else); .
  299.  
  300. PROCEDURE UpdateChange (Decisions, Rule)
  301.  
  302. Decision (_, _, TestKind (_, Path, ..), _, IsUnchanged),
  303.    Rule (HasExit := (TRUE), HasAssign := (TRUE), Statements := s) ;
  304. Decision (_, _, TestIsType (_, Path, ..), _, IsUnchanged),
  305.    Rule (HasExit := (TRUE), HasAssign := (TRUE), Statements := s) :-
  306.    IsChanged (Path, s);
  307.    IsUnchanged := FALSE;
  308.    .
  309.  
  310. PREDICATE IsChanged (Path, Statements)
  311.  
  312. path, Assignment (Object := Object) :- Object # NIL; IsSamePath (path, Object^.Formal.Path); .
  313. Path, Statement (_, Next) :- IsChanged (Path, Next); .
  314.  
  315. PROCEDURE FindCases (Decisions => Path, SHORTCARD, tSet)
  316.  
  317. Decision (Then, Else, TestKind (_, Path, NodeTypes (
  318.    TreeName (_, _, _, _, ClassCount), Types), _), _, _) ;
  319. Decision (Then, Else, TestIsType (_, Path, NodeTypes (
  320.    TreeName (_, _, _, _, ClassCount), Types), _), _, _) => Path, k, s :-
  321.    FindCases (Then => _, m, s1);
  322.    MarkCases (Then, m, s1);
  323.    FindCases (Else => Path2, n, s2);
  324. k: SHORTCARD, s: tSet;
  325. {
  326.    IF n = 0 THEN
  327.       k := 1;
  328.       MakeSet (s, ClassCount);
  329.       Assign (s, Types);
  330.    ELSIF IsSamePath (Path, Path2) AND IsDisjoint (s2, Types) THEN
  331.       k := n + 1;
  332.       s := s2;
  333.       Union (s, Types);
  334.    ELSE
  335.       MarkCases (Else, n, s2);
  336.       k := 1;
  337.       MakeSet (s, ClassCount);
  338.       Assign (s, Types);
  339.    END;
  340. };
  341.    .
  342. Decision (Then, Else, _, _, _) => _, 0, _ :-
  343.    FindCases (Then => _, m, s1);
  344.    MarkCases (Then, m, s1);
  345.    FindCases (Else => _, n, s2);
  346.    MarkCases (Else, n, s2);
  347.    .
  348. Decided (Else, _) => _, 0, _ :-
  349.    FindCases (Else => _, n, s2);
  350.    MarkCases (Else, n, s2);
  351.    .
  352. NoDecision () => _, 0, _ :- .
  353.  
  354. PROCEDURE MarkCases (Decisions, SHORTCARD, tSet)
  355.  
  356. Decision (_, _, _, Cases, _), n, s :- n >= 7; Cases := n; ReleaseSet (s); .
  357.  
  358. PROCEDURE ElimDeadTests (Decisions, Path, BOOLEAN, tSet)
  359.  
  360. Decision (Then, Else, TestKind (_, Path, NodeTypes (
  361.    TreeName (_, _, _, _, ClassCount), Types), _), _, _), _, (FALSE), _ ;
  362. Decision (Then, Else, TestIsType (_, Path, NodeTypes (
  363.    TreeName (_, _, _, _, ClassCount), Types), _), _, _), _, (FALSE), _ :-
  364.  
  365. s: tSet;
  366. {  MakeSet (s, ClassCount); IF IsDeadEnd (Then) THEN Assign (s, Types); END; };
  367.    ElimDeadTests (Else, Path, (TRUE), s);
  368.    ElimDeadTests (Then, _, (FALSE), _);
  369.    .
  370. Decision (Then, Else, Test:TestKind (Next, Path, NodeTypes (
  371.    Tree:TreeName (_, _, _, _, ClassCount), Types), Name), _, _), Path2, b, s ;
  372. Decision (Then, Else, Test:TestIsType (Next, Path, NodeTypes (
  373.    Tree:TreeName (_, _, _, _, ClassCount), Types), Name), _, _), Path2, b, s :-
  374.  
  375. types: tSet, s2: tSet;
  376. {
  377.    s2 := s;
  378.    IF IsSamePath (Path, Path2) THEN
  379.       IF NOT IsDisjoint (Types, s) THEN
  380.      types := Types;
  381.      Test := mTestIsType (Next, Path, mNodeTypes (Tree, types), Name);
  382.      MakeSet (Types, ClassCount);
  383.      Assign (Types, types);
  384.      Difference (Types, s);
  385.       END;
  386.    ELSE
  387.       AssignEmpty (s2);
  388.    END;
  389.    IF IsDeadEnd (Then) THEN Union (s2, Types); END;
  390. };
  391.    ElimDeadTests (Else, Path, (TRUE), s2);
  392.    ElimDeadTests (Then, _, (FALSE), _);
  393.    .
  394. Decision (Then, Else, _, _, _), _, b, s :-
  395. {  IF b THEN ReleaseSet (s); END; };
  396.    ElimDeadTests (Else, _, (FALSE), _);
  397.    ElimDeadTests (Then, _, (FALSE), _);
  398.    .
  399. Decided (Else, Rule (HasExit := HasExit)), _, b, s :-
  400. {  IF b THEN ReleaseSet (s); END; };
  401. {  IF NOT HasExit THEN ReportWarning (Else); END; };
  402.    ElimDeadTests (Else, _, (FALSE), _);
  403.    .
  404. NoDecision (), _, (TRUE), s :-
  405.    ReleaseSet (s);
  406.    .
  407.  
  408. PREDICATE IsDeadEnd (Decisions)
  409.  
  410. Decided (Else, Rule (HasExit := HasExit)) :- NOT HasExit OR IsDeadEnd (Else); .
  411.  
  412. PROCEDURE ReportWarning (Decisions)
  413.  
  414. Decided (Else, Rule (Pos, ..)) :-
  415.    Warning ("unreachable code", Pos);
  416.    ReportWarning (Else);
  417.    .
  418. Decision (Then, Else, ..) :-
  419.    ReportWarning (Then);
  420.    ReportWarning (Else);
  421.    .
  422.  
  423. /*
  424. PROCEDURE WriteTests (Tests)
  425.  
  426. o:OneTest (Next, _) :- WriteTest (o); WriteTests (Next); .
  427.  
  428. PROCEDURE WriteTest (OneTest)
  429.  
  430. TestKind (Next, Path, TypeDesc, _) :-
  431.    "TestKind    "; ImplMod (Path); "    "; WriteType (TypeDesc); NL .
  432. TestIsType (Next, Path, TypeDesc, _) :-
  433.    "TestIsType    "; ImplMod (Path); "    "; WriteType (TypeDesc); NL .
  434. TestNil (Next, Path) :-
  435.    "TestNil    "; ImplMod (Path); "    "; NL .
  436. TestNonlin (Next, Path, Path2, _) :-
  437.    "TestNonlin    "; ImplMod (Path); "    "; ImplMod (Path2); NL .
  438. TestValue (Next, ..) :-
  439.    "TestValue    "; NL .
  440.  
  441. PROCEDURE WriteType (TypeDesc)
  442.  
  443. NodeTypes (TreeName (Name, ..), Types) :-
  444.    WriteIdent (StdOutput, Name); WriteSet (StdOutput, Types); .
  445. UserType (Type) :-
  446.    WriteIdent (StdOutput, Type); .
  447.  
  448. PROCEDURE WriteDecisions (Decisions, SHORTCARD) LOCAL { VAR i: SHORTCARD; }
  449.  
  450. Decision (Then, Else, Test, _, _), n :-
  451.    { FOR i := 1 TO n DO WriteS (StdOutput, "    "); END; };
  452.    WriteTest (Test);
  453.    WriteDecisions (Then, n + 1);
  454.    WriteDecisions (Else, n);
  455.    .
  456. Decided (Else, rule), n :-
  457.    { FOR i := 1 TO n DO WriteS (StdOutput, "    "); END; };
  458.    WriteI (StdOutput, rule^.Rule.Line, 3); NL
  459.    WriteDecisions (Else, n);
  460.    .
  461. */
  462.